COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY SQTILE
C00005 00003	INTERNAL PROCEDURE SQTILE(REFERENCE INTEGER PIC1 INTEGER YL1,XL1, TY,TX,YSQ,XSQ
C00008 00004	      BEGIN "write inner loop"
C00012 ENDMK
C⊗;
ENTRY SQTILE;
BEGIN "SQTILE"
REQUIRE "{}{}" DELIMITERS;

DEFINE PCLN=0;  comment index of word in a picture file containing
			number of scanlines in the picture;
DEFINE PCWD=1;	comment number of words in the picture;
DEFINE PCBY=2;	comment number of valid bytes in the picture;
DEFINE PCBYA=3;	comment no. of bytes including the nulls at the end of lines;
DEFINE LNWD=4;	comment no. of words per scanline;
DEFINE LNBY=5;	comment no. of valid bytes per scanline;
DEFINE LNBYA=6;	comment no. of bytes per scanline, including the nulls;
DEFINE WDBY=7;	comment no. of bytes per word;
DEFINE WDBI=8;	comment no. of bits containing data in a word;
DEFINE BYBI=9;	comment no. of bits per byte;
DEFINE BMAX=10;	comment largest value of a byte;
DEFINE BPTAB=11; comment address of second entry in byte pntr. table;
DEFINE LINTAB=12; comment actual address of the first entry in the row table;

DEFINE ILDB(A,B)={'134000000000 LOR (A LSH 23) LOR B};
DEFINE IDPB(A,B)={'136000000000 LOR (A LSH 23) LOR B};
DEFINE ADD(A,B)={'270000000000 LOR (A LSH 23) LOR B};
DEFINE ADDI(A,B)={'271000000000 LOR (A LSH 23) LOR B};
DEFINE IMULI(A,B)={'221000000000 LOR (A LSH 23) LOR B};
DEFINE IDIVI(A,B)={'231000000000 LOR (A LSH 23) LOR B};
DEFINE MOVE(A,B)={'200000000000 LOR (A LSH 23) LOR B};
DEFINE MOVEI(A,B)={'201000000000 LOR (A LSH 23) LOR B};
DEFINE MOVEM(A,B)={'202000000000 LOR (A LSH 23) LOR B};
DEFINE POPJ(A,B)={'263000000000 LOR (A LSH 23) LOR B};
DEFINE SOJG(A,B)={'367000000000 LOR (A LSH 23) LOR B};
INTERNAL PROCEDURE SQTILE(REFERENCE INTEGER PIC1; INTEGER YL1,XL1, TY,TX,YSQ,XSQ;
                          REFERENCE INTEGER PIC2; INTEGER YL2,XL2);
   BEGIN
   INTEGER PT1CI,PT2AI,FAC;
   comment
     copy a TY*YSQ by TX*XSQ window from PIC1 with upleft corner YL1,XL1 into
     a TY by TX window in PIC2 with upleft at YL2,XL2 each destination pixel
     is appropriately scaled sum of YSQ*XSQ source pixels;

   IF XL1<0 THEN BEGIN TX←TX+XL1%XSQ; XL2←XL2-XL1%XSQ; XL1←0; END;
   IF YL1<0 THEN BEGIN TY←TY+YL1%YSQ; YL2←YL2-YL1%YSQ; YL1←0; END;
   IF XL2<0 THEN BEGIN TX←TX+XL2; XL1←XL1-XL2*XSQ; XL2←0; END;
   IF YL2<0 THEN BEGIN TY←TY+YL2; YL1←YL1-YL2*YSQ; YL2←0; END;

   TX←(MEMORY[LOCATION(PIC1)+LNBY]-XL1)%XSQ MIN TX;  comment bounds test;
   TX←(MEMORY[LOCATION(PIC2)+LNBY]-XL2) MIN TX;
   TY←(MEMORY[LOCATION(PIC1)+PCLN]-YL1)%YSQ MIN TY;
   TY←(MEMORY[LOCATION(PIC2)+PCLN]-YL2) MIN TY;

   IF MEMORY[LOCATION(PIC2)+LNBY]≤0 ∨ MEMORY[LOCATION(PIC2)+PCLN]≤0 ∨
      TX<1 ∨ TY<1 ∨ XSQ<1 ∨ YSQ<1 THEN RETURN;

   PT1CI←MEMORY[MEMORY[LOCATION(PIC1)+BPTAB]+XL1-1]
          +MEMORY[LOCATION(PIC1)+LINTAB+YL1]; comment source byte pointer;

   PT2AI←MEMORY[MEMORY[LOCATION(PIC2)+BPTAB]+XL2-1]
          +MEMORY[LOCATION(PIC2)+LINTAB+YL2]; comment destination byte pointer;

   FAC←
   IF MEMORY[LOCATION(PIC2)+BMAX]<MEMORY[LOCATION(PIC1)+BMAX]*XSQ*YSQ THEN
      (MEMORY[LOCATION(PIC1)+BMAX]*XSQ*YSQ) % MEMORY[LOCATION(PIC2)+BMAX] ELSE
      - MEMORY[LOCATION(PIC2)+BMAX] % (MEMORY[LOCATION(PIC1)+BMAX]*XSQ*YSQ) ;
   IF FAC>0 ∧ (MEMORY[LOCATION(PIC1)+BMAX]*XSQ*YSQ)%FAC >
               MEMORY[LOCATION(PIC2)+BMAX] THEN FAC←FAC+1;
   IF ABS(FAC)=1 THEN FAC←0; 
   comment do samples have to be multiplied or divided to scale properly?;

      BEGIN "write inner loop"

      DEFINE SUM=1, OVR=2, PT1=3, PT1A=4, PT1C=5, LPX=6, LPY=7,
             PT2='10, PT2A='11, PT1B='13;

      INTEGER LPYB,LPXB,I,J,CP;
      INTEGER ARRAY CODE[1:(XSQ*2+2)*YSQ+14];

      CP←0;
      CODE[CP←CP+1]←       MOVE(PT1C,LOCATION(PT1CI));
      CODE[CP←CP+1]←       MOVE(PT2A,LOCATION(PT2AI));
      CODE[CP←CP+1]←       MOVEI(LPY,TY);
		      LPYB←                                LOCATION(CODE[CP+1]);
      CODE[CP←CP+1]←       MOVE(PT1A,PT1C);
      CODE[CP←CP+1]←       ADDI(PT1C,MEMORY[LOCATION(PIC1)+LNWD]*YSQ);
      CODE[CP←CP+1]←       MOVE(PT2,PT2A);
      CODE[CP←CP+1]←       ADDI(PT2A,MEMORY[LOCATION(PIC2)+LNWD]);
      CODE[CP←CP+1]←       MOVEI(LPX,TX);

		      LPXB←                                LOCATION(CODE[CP+1]);
      FOR I←1 STEP 1 UNTIL YSQ DO
	 BEGIN
	 CODE[CP←CP+1]←MOVEM(PT1A,PT1);
	 FOR J←1 STEP 1 UNTIL XSQ DO
	    BEGIN
	    IF I=1 ∧ J=1 THEN CODE[CP←CP+1]← ILDB(SUM,PT1)
	    ELSE BEGIN CODE[CP←CP+1]←ILDB(0,PT1); CODE[CP←CP+1]←ADD(SUM,0); END;
	    IF I=1 ∧ J=XSQ THEN CODE[CP←CP+1]←MOVEM(PT1,PT1B);
	    END;
	 IF I≠YSQ THEN CODE[CP←CP+1]←ADDI(PT1A,MEMORY[LOCATION(PIC1)+LNWD]);
	 END;

      IF FAC≠0 THEN CODE[CP←CP+1]← IF FAC<0 THEN IMULI(SUM,-FAC) ELSE IDIVI(SUM,FAC);
      CODE[CP←CP+1]←       IDPB(SUM,PT2);
      CODE[CP←CP+1]←       MOVE(PT1A,PT1B);
      CODE[CP←CP+1]←       SOJG(LPX,LPXB);
      CODE[CP←CP+1]←       SOJG(LPY,LPYB);
      CODE[CP←CP+1]←       POPJ('17,0);

      START_CODE PUSHJ '17,ACCESS(CODE[1]); END;

      END;
   END;
END "SQTILE";